Monster Media 1996 #15/Monster Media Number 15 (Monster Media)(July 1996).ISO/tbbs/prgsourc.zip/HOMES.ZIP/PSUB.PRG

Text File | 1996-01-08 | 6KB | 228 lines

PROCEDURE psub
PARAMETERS md

SELECT e

PRIVATE x
PRIVATE y
PRIVATE z
PRIVATE page
PRIVATE cnt

COUNT TO cnt
GOTO TOP

IF cnt > 15
   page = 15
   x = cnt/15
   z = Int(x) + 1
   DECLARE asub[z]
   x = 1
   asub[x] = sname
   x = 2
   DO WHILE x <= z
      SKIP 15
      asub[x] = sname
      x = x + 1
   ENDDO
ELSE
   page = cnt
ENDIF

SET COLOR TO GR+/R
@ 21,0 CLEAR TO 23,79
@ 21,5 SAY "Up/Dn Arrow "
IF cnt > 15
   @ 21,55 SAY "<Page Up>"
   @ 22,55 SAY "<Page Dn>"
ENDIF
@ 23,5 SAY "S"
@ 22,5 SAY "<Enter> "
IF md > 2
   @ 23,55 SAY "N"
ENDIF
SET COLOR TO W+/R
@ 21,17 SAY "= Move within pick list"
IF cnt > 15
   @ 21,65 SAY "= Page Up"
   @ 22,65 SAY "= Page Down"
ENDIF
@ 23,7 SAY "= Not in Subdivision"
@ 22,13 SAY "= Select from pick list"
IF md > 2
   @ 23,57 SAY "= No Preference"
ENDIF

SET COLOR TO BG/BG
@ 3,50 CLEAR TO page+4,74
SET COLOR TO N/BG
@ 3,50 TO page+4,74

GOTO TOP
y = 1
x = 1
DO WHILE x + (15 * (y - 1)) < cnt .AND. x < 15
   SKIP
   x = x + 1
   @ x+3,51 SAY sname
ENDDO

SET COLOR TO GR+/BG
SEEK asub[y]
@ 4,51 SAY sname

x = 1
SET FORMAT TO fscr NOCLEAR
SET COLOR TO N/N
@ 2,0 GET charin
DO WHILE .T.
   READ
   DO CASE
      CASE LastKey() = 3                         && <Page Down>
           IF y = z
              LOOP
           ENDIF
           SET COLOR TO N/BG
           y = y + 1
           IF y = z
              @ 4,51 CLEAR TO page+3,73
           ENDIF
           SEEK asub[y]
           x = 1
           DO WHILE x + (15 * (y - 1)) < cnt .AND. x < 15
              SKIP
              x = x + 1
              @ x+3,51 SAY sname
           ENDDO
           SET COLOR TO GR+/BG
           SEEK asub[y]
           @ 4,51 SAY sname
           x = 1
           LOOP

      CASE LastKey() = 5                         && <Up Arrow>
           IF x = 1 .AND. y = 1
              LOOP
           ENDIF
           SET COLOR TO N/BG
           IF x = 1
              y = y - 1
              SEEK asub[y]
              @ 4,51 SAY sname
              x = 1
              DO WHILE x < 15
                 SKIP
                 x = x + 1
                 @ x+3,51 SAY sname
              ENDDO
              SET COLOR TO GR+/BG
              @ x+3,51 SAY sname
           ELSE
              @ x+3,51 SAY sname
              x = x - 1
              SKIP -1
              SET COLOR TO GR+/BG
              @ x+3,51 SAY sname
           ENDIF
           LOOP

      CASE LastKey() = 13                        && <Enter>
           DO CASE
              CASE md = 1                       && Called by enew(list)
                   cksub = sname
              CASE md = 2                       && Called by enew(add)
                   SELECT a
                   REPLACE sub WITH e->sname
              CASE md = 3 .OR. md = 4          && Called by search
                   SELECT d
                   REPLACE sub WITH e->sname
           ENDCASE
           EXIT

      CASE LastKey() = 18                        && <Page Up>
           IF y = 1
              LOOP
           ENDIF
           SET COLOR TO N/BG
           y = y - 1
           SEEK asub[y]
           x = 1
           DO WHILE x < 15
              SKIP
              x = x + 1
              @ x+3,51 SAY sname
           ENDDO
           SET COLOR TO GR+/BG
           SEEK asub[y]
           @ 4,51 SAY sname
           x = 1
           LOOP

      CASE LastKey() = 24                        && <Dn Arrow>
           IF x + (15 * (y - 1)) = cnt
              LOOP
           ENDIF

           SET COLOR TO N/BG
           IF x = 15
              IF y = z
                 LOOP
              ENDIF
              y = y + 1
              IF y = z
                 @ 4,51 CLEAR TO page+3,73
              ENDIF
              SEEK asub[y]
              x = 1
              DO WHILE x + (15 * (y - 1)) < cnt .AND. x < 15
                SKIP
                x = x + 1
                @ x+3,51 SAY sname
              ENDDO
              SET COLOR TO GR+/BG
              SEEK asub[y]
              @ 4,51 SAY sname
              x = 1
           ELSE
              @ x+3,51 SAY sname
              x = x + 1
              SKIP
              SET COLOR TO GR+/BG
              @ x+3,51 SAY sname
           ENDIF
           LOOP

      CASE LastKey() = 27                       && <Esc>
           IF md = 3 .OR. md = 4
              SELECT d
           ENDIF
           EXIT

      CASE LastKey() = 78 .OR. LastKey() = 110     && No Preference
           IF md < 3
              LOOP
           ENDIF
           SELECT d
           REPLACE sub WITH "..No Preference          "
           EXIT

      CASE LastKey() = 83 .OR. LastKey() = 115     && Not in Subdivision
           DO CASE
              CASE md = 1                       && Called by enew(list)
                   LOOP
              CASE md = 2                       && Called by enew(add)
                   SELECT a
                   REPLACE sub WITH "..Not in Subdivision     "
              CASE md = 3 .OR. md = 4          && Called by search
                   SELECT d
                   REPLACE sub WITH "..Not in Subdivision     "
           ENDCASE
           EXIT

      ENDCASE
ENDDO
RELEASE asub
DO cls WITH 2,50,19,74
RETURN